perm filename LOOP.FAI[NEW,LCS]23 blob sn#403121 filedate 1978-12-07 generic text, type T, neo UTF8
00100		TITLE LOOP	;	SUBROUTINE LOOP(I,J,L,M,N)
00200		ENTRY LOOP,FINDIT,PLACE,DPYNEW,MVBEAM,MVBX,JUGGLE,XNOTE,BAUTO,RNX,RCURVE
00300		ENTRY SORT2,UPDATE,NEWR,MSSLUP,LUP2,HOMER,CODN,FSCAN,NALF,BOX,PARCH
00400		ENTRY RJED,RJED2,EDX,EQUAL,BOXX
00500	
00600		EXTERNAL ACCPOG,DPYOUT,.COMM.,XRN,AMOD,PTR,KJY,DPY,DL,SCM,RNW,YED
00700		EXTERNAL SC,SCX,RRJJ,STF,ALF,POSI,RMOD,RINP,SIZ,HOMX,LIMIT,IDEV
00800		EXTERNAL RHORZ,SETCUR,DPYSET,DPYBRT,SETPOG,ALINE,DPTR,ALOG,JCHAR
00900	MM←1 ↔ NN←2 ↔ JK←3 ↔JT←4 ↔IEND←5 ↔A←6 ↔K←7↔ IS←10↔ IZ←11↔ R←12↔ L←13   
01000	RC←14 ↔ NX←15	;**** AC'S 0,1,2,3,5  ARE USED IN 'PLACE' & 'FINDIT'!!
01100				;	DIMENSION N(1)
01200	LOOP:	0		;	DO 1 NN=I+L,J+L,K
01300		MOVE	1,@4(16)
01400		SUB 	1,@3(16) 	; MM IS IN 1
01500		MOVE	2,@(16)
01600		ADD	2,@3(16)	;I+L  -- NN, 1ST TIME
01700		MOVE	3,@1(16)
01800		ADD	3,@3(16)	;J+L
01900		HRRZI	5,@5(16)		; ADR. OF N
02000		ADDI	2,-1(5)		; N(NN)
02100		ADDI	3,-1(5)
02200		MOVE	4,@2(16)	;K
02300		JUMPL	4,LP3		; JUMP IF NEG. INCR.
02400		HRRM	1,.+1		; ADD IN MM 
02500	LP1:	MOVE	6,(2)
02600		MOVEM	6,(2)		;N(NN)=N(NN+MM)
02700		CAIGE	2,(3)
02800		AOJA	2,LP1
02900		JRA	16,6(16)
03000	LP3:	HRRM	1,.+1
03100	LP2:	MOVE	6,(2)		;NEG. INCR.
03200		MOVEM	6,(2)
03300		CAILE	2,(3)
03400		SOJA	2,LP2
03500		JRA 	16,6(16)	;	END
03600	
03700	PLACE:	0	;	FUNCTION PLACE(X)
03800	;	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)/XRN/RN(4000)
03900	;	EQUIVALENCE (R11,RJQ(9)),(RD,RN(4000))
04000		MOVN	2,@(16) ;	PLACE=R11-ABS(RD-X)
04100		FADR	2,RMOD+=9 	;END
04200		MOVMS	2
04300		MOVE 	0,.COMM.+=12	;R11
04400		FSBR	0,2
04500		JRA	16,1(16)
04600	
04700	FINDIT:	0    ;	FUNCTION FINDIT(N)
04800		SETZ   ;	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
04900		HRRZ	1,@(16) ; COMMON /XRN/RN(4000) /PTR/PWDS(250),ITEM,L,I,IX
05000	;;	HRRZI	2,PTR  ;	FINDIT=0
05100	;;	ADDI	1,(2)  ;	L=PWDS(N)
05200	;;	MOVE	2,-1(1) ;	IF(RN(L+1).NE.1)GO TO 377
05300	;;	FIXX(2)         ;	IF(RN(L+2).EQ.R2)RETURN
05400	;;	HRRZI	3,XRN     ;377	FINDIT=-1
05500	;;	ADDI	3,(2)   ;	END
05600		MOVE 2,PTR-1(1)		;THESE 3 REPLACE ABOVE
05700		MOVE 5,XRN(2)
05800		CAME	5,[1.0]
05900		JRST	FNEG
06000		MOVEM	2,LIMIT+2     ; SENDS BACK A NUM IN L
06100		MOVE 5,XRN+1(2)
06200		CAME	5,.COMM.
06300	FNEG:	SETO
06400		JRA	16,1(16)
06500	
06600	DPYNEW:	0    ;	SUBROUTINE DPYNEW
06700		JSA	16,ACCPOG    ; COMMON/DPY/ST(4000),WDS(250),MEDIT,IGO
06800		JUMP	[1]    ;	CALL ACCPOG(1)
06900		MOVE	2,DPY+=4001    ;	IF(IGO.GT.0)RETURN
07000		JUMPG	2,DB    ;	CALL DPYOUT(1)
07100		JSA	16,DPYOUT    ;	END
07200		JUMP	[1]
07300	DB:	JRA	16,(16)
07400	
07500	MVBEAM:	0  ;C  THESE MOVE ENDS OF PARTIAL INNER BEAMS.
07600		HRRZ	2,(16) ;	SUBROUTINE MVBEAM(R,I,JY,L,W)
07700		ADD     2,@1(16)  ; 	+I
07800		MOVE 3,2          ;C  L AND JY ARE FOR MOVES TO DIFF. STAFF.
07900		ADD	2,@2(16)  ;	+JY         DIMENSION R(1)
08000		MOVE	2,-1(2)  ;	Y=R(JY+I)
08100				 	;	Z=ABS(Y)
08200					;	IF(Z.LT.100.)GO TO 1
08300					;  IF(I.GT.5)GO TO 1
08400	;C  NEXT FOR MINIS, DIAMONDS, 'X' NOTES. (LIMIT OF +-99 ON ALTITUDE.)
08500					;	Y=AMOD(Y,100.)
08600					;	Z=Z-ABS(Y)+ABS(X)
08700					;	IF(X)Z=-Z
08800					;	GO TO 2
08900	    	FADR	2,@4(16)  ;1	Z=Y+W
09000		ADD	3,@3(16)     ;  +L
09100		MOVEM	2,-1(3)  ; PUT IT IN R(L+I)
09200		JRA	16,5(16)	; END
09300	
09400	MVBX:	0   ;	SUBROUTINE MVBX(I)
09500	;     COMMON R2,JA,CENTR,J2,RJQ(20),L,RDIS,JQ(18)/KJY/K,JY/XRN/R(4000)
09600		HRRZI 1,XRN	; LOC OF XRN
09700		ADD    1,@(16)  ;	EQUIVALENCE (R4,RJQ(2)),(R8,RJQ(6))
09800		MOVE 2,1
09900		ADD	2,KJY+1 ;	R(L+I)=R8+(R(JY+I)-R4)*RDIS
10000		MOVE 3,-1(2)
10100		FSBR	3,.COMM.+5
10200		FMPR	3,.COMM.+=25  ; *RDIS
10300		FADR	3,.COMM.+=9   ; +R8
10400		ADD	1,.COMM.+=24   ; + L
10500		MOVEM 3,-1(1)
10600		JRA	16,1(16)
10700	
10800	JUGGLE:	0    ;	SUBROUTINE JUGGLE
10900	;	IMPLICIT INTEGER(A-Z)
11000	;	REAL PWDS,RN
11100	;	COMMON /DL/X22,SAVER,NAME /XRN/RN(4000)
11200	;     COMMON/PTR/PWDS(250),ITEM,L,I,IX/DPY/ST(4000),WDS(250),MEDIT,IGO
11300		SOS	LIMIT+1 	;ITEM=ITEM-1
11400		HRRZI	15,XRN	;	JX=RN(MEDIT)+3   WD CNT OF OLD ITEM
11500		ADD	15,DPY+=4000	;C  I-IX IS WD CNT OF NEW ITEM
11600		KIFIX 14,-1(15)		;MOVE	14,-1(15)
11700		ADDI	14,3  		; JX
11800		MOVE	13,LIMIT+4  	;JY=IX
11900		MOVE	11,LIMIT+3  	; I
12000		SUB	11,13
12100		SUB	11,14		;Z=I-IX-JX    SPACE CHANGE
12200		JUMPL	11,J2751   	;IF(Z)2751,172,751
12300		JUMPE	11,J172
12400		MOVE	5,LIMIT+3   ;751   CALL LOOP(I-1,MEDIT+JX,-1,Z,0,RN)
12500		SUBI	5,1
12600		MOVE	10,DPY+=4000
12700		ADD	10,14
12800		JSA	16,LOOP
12900		JUMP	5
13000		JUMP	10
13100		JUMP	[-1]
13200		JUMP	11
13300		JUMP	[0]
13400		JUMP	XRN
13500		ADD	13,11		;JY=IX+Z
13600		JRST	J172		;GO TO 172
13700	J2751:	ADD	14,DPY+=4000 ;2751  CALL LOOP(MEDIT+JX+Z,IX+Z-1,1,0,-Z,RN)
13800		ADD	14,11
13900		MOVE	5,11
14000		ADD	5,LIMIT+4  
14100		SOJ	5,
14200		MOVN	10,11
14300		JSA	16,LOOP
14400		JUMP	14
14500		JUMP	5
14600		JUMP	[1]
14700		JUMP	[0]
14800		JUMP	10
14900		JUMP	XRN
15000					;172	J=RN(JY)+2	
15100	J172:	KIFIX 12,XRN-1(13)	;MOVE 12,XRN-1(13)
15200		ADDI	12,2		; J IS IN 12
15300		JSA	16,LOOP		;CALL LOOP(0,J,1,MEDIT,JY,RN)
15400		JUMP	[0]
15500		JUMP	12
15600		JUMP	[1]
15700		JUMP	DPY+=4000	; MEDIT
15800		JUMP 	13		; JY
15900		JUMP	XRN
16000		MOVE	12,LIMIT+4  	; I=IX+Z
16100		ADD	12,11		; Z IS IN 11
16200		MOVEM	12,LIMIT+3  
16300		MOVE	12,LIMIT+1    	; 1751	X=ITEM+1
16400		AOJ	12,	    	; X IS IN 12
16500		HRRZI	13,DPTR     	; JX=WDS(X22+1)-WDS(X22)
16600		ADD	13,DL	
16700		MOVE	14,(13)   	; WDS(X22+1) IN 14  ADR. WDS(X22) IN 13
16800		SUB  	14,-1(13)	;JX IN 14
16900		HRRZI	10,DPTR        	;  J=WDS(X+1)-WDS(X)
17000		ADDI	10,(12)
17100		MOVE	7,(10)		;WDS(X+1)
17200		SUB	7,-1(10)		;J IN 7
17300		MOVEM	7,MVBX		; STORE J
17400		SUB	7,14    	; Y=J-JX
17500		MOVE	14,-1(10)  	;  JX=WDS(X)+Y+1
17600		ADD	14,7
17700		AOJ	14,		; JX IN 14
17800		JUMPL	7,J2851   	;  IF(Y)2851,182,282
17900		JUMPE	7,J182
18000		MOVE	15,(10) ;282  CALL LOOP(WDS(X+1)+2,WDS(X22),-1,Y,0,ST)
18100		ADDI	15,2	  	; ARG 1
18200		MOVE	6,-1(13) 	;  ARG 2
18300		JSA	16,LOOP
18400		JUMP	15
18500		JUMP	6 
18600		JUMP	[-1]
18700		JUMP	7	  	; Y
18800		JUMP	[0]
18900		JUMP	DPY
19000		JRST	J182   		;  GO TO 182
19100	J2851:	MOVE	14,(13) ;2851  CALL LOOP(WDS(X22+1)+Y+1,WDS(X)+Y+1,1,0,-Y,ST)
19200		ADD	14,7		;+Y
19300		ADDI	14,1		; ARG 1
19400		MOVE	5,-1(10) 	;WDS(X)
19500		ADD	5,7
19600		ADDI	5,1		; ARG 2
19700		MOVNM	7,MVBEAM	; -Y IS STORED
19800		JSA	16,LOOP
19900		JUMP	14
20000		JUMP	5
20100		JUMP	[1]
20200		JUMP	[0]
20300		JUMP	MVBEAM
20400		JUMP	DPY
20500		MOVE	14,-1(10)  	; WDS(X)   JX=WDS(X)+1
20600		ADDI	14,1		; JX IN 14
20700	J182:	MOVE	5,-1(13)  ;182	CALL LOOP(1,J,1,WDS(X22)+1,JX,ST)
20800		ADDI	5,1   	;WDS(X22)+1
20900		JSA	16,LOOP
21000		JUMP	[1]
21100		JUMP	MVBX
21200		JUMP	[1]
21300		JUMP	5  
21400		JUMP	14 
21500		JUMP	DPY
21600		MOVE	2,DL    	; DO 183 K=X22+1,X
21700						; 183	WDS(K)=WDS(K)+Y
21800		HRRZI	3,PTR
21900		ADDI	3,(2)
22000	J183:	JUMPE	11,J184		;IF(Z.EQ.0)GO TO 184
22100		ADDM 11,(3)		; PWDS(K)=PWDS(K)+Z
22200		AOJ	3,	;UPDATE PWDS AND WDS
22300	J184:	JUMPE	7,J185
22400		ADDM 7,(13)
22500		AOJ 13,
22600	J185:	CAIGE	2,(12)
22700		AOJA	2,J183			;ST(2)=WDS(X)
22800		MOVE 2,DPTR-1(12)
22900		MOVEM 2,DPY+1
23000		SETZM	DL		;X22=0
23100		JRA	16,(16)
23200	
23300	SORT2:	0		;SUBROUTINE SORT2(RPOS,M)
23400		MOVEI	2,2	;DIMENSION RPOS(2,200)
23500	S3:	MOVE	6,2	;(K=L HERE)
23600		SETO	11,	;L=2
23700		HRRZI	3,@(16)	;3	J=-1
23800		MOVE	4,2	;RX=RPOS(1,L-1)
23900		SUBI	4,1	;L-1
24000		IMULI	4,2
24100		ADDI	4,(3)
24200		MOVE	5,-2(4)	;RX
24300	S2:	MOVE 	7,6	;	DO 2 K=L,M
24400					;IF(RPOS(1,K).GE.RX)GO TO 2
24500		IMULI	7,2	;IF(RPOS(1,K).GE.RX)GO TO 2
24600		ADDI	7,(3)
24700		CAMG	5,-2(7)
24800		JRST	S1	; CONTINUE
24900		MOVE	5,-2(7)	;  RX=RPOS(1,K);;WHY WERE ALL THE RX'S  JX ????? 9/6/73
25000		MOVE 	11,6	;J=K
25100	S1:	CAMGE	6,@1(16)	;2	CONTINUE
25200		AOJA	6,S2
25300		JUMPL	11,S4	;IF(J)GO TO 4
25400		MOVE	12,2	;K=L-1
25500		SOS	12
25600		IMULI	12,2	;(K*2)
25700		ADD	12,3	;CALL EXCH(RPOS(1,K),RPOS(1,J))
25800		MOVE	10,-2(12)
25900		IMULI	11,2
26000		ADD	11,3
26100		EXCH	10,-2(11)
26200		MOVEM	10,-2(12)
26300		MOVE	10,-1(12)	;CALL EXCH(RPOS(2,K),RPOS(2,J))
26400		EXCH	10,-1(11)
26500		MOVEM	10,-1(12)
26600	S4:	CAMGE	2,@1(16)	;4	L=L+1
26700		AOJA	2,S3		;IF(L.LE.M)GO TO 3
26800		JRA	16,2(16)	;END
26900	
27000	XNOTE:	0		;FUNCTION XNOTE(J)
27100		MOVE 	3,@(16)		;COMMON/XRN/RN(4000)
27200		IMULI	3,12		;DIMENSION R(10,80)
27300						;EQUIVALENCE (R,RN(3001))
27400						;XNOTE=AMOD(R(4,J),100.)
27500		MOVE 2,RINP-7(3)
27600		JSA	16,AMOD
27700		JUMP	2
27800		JUMP	[=100.0]
27900		CAML [80.0]		;IF(XNOTE.GE.80)XNOTE=XNOTE-100
28000		FSBR [100.0]		; FOR NEG. MINIS, ETC.
28100		MOVE 2,RINP-1(3)	;GET R(10,J)
28200		JUMPE 2,XJRA    	;RETURN IF 0
28300	;;	MOVE 3,[5.0]		; ON STF ABOVE, +5 HGT.
28400	;;	CAMN 2,[1.0]		; 1=STF BELOW
28500	;;	MOVNS 3			; MAKE IT -5
28600	;;	FADR 3			;ADD IT TO XNOTE
28700		KIFIX 3,SCM+=80
28800		MOVE 4,STF(3)		;RSTFAC(STAFF)
28900		ADDI 3,POSI		;X=(THAT STAFF-THIS STAFF)/7.0
29000		MOVE 1,(3)		;THIS STAFF POS.
29100		AOJ  3,			;LOOK AT UPPER STAFF?
29200		CAMN 2,[1.0]
29300		SUBI 3,2		;NO, LOOK AT LOWER
29400		FSBR 1,(3)		;MINUS THAT STAFF POS.
29500	;X	FADR 1,[123.0]		;+ BASIC DIFF. IN STAFF POS.
29600	;X	FMPR 1,STF+=8		;* RSTJ2
29700	;X  	FSBR 1,[123.0]
29800		FDVR 1,4     	;--OR--  XNOTE=(THIS-THAT)/(-7*RSTFAC(STAFF)
29900		FDVR 1,[-7.0]		; /-7.
30000		FADR 0,1
30100	XJRA:	JRA	16,1(16)	;END
30200	
30300	BAUTO:	0		;	SUBROUTINE BAUTO(J,L,K,N)
30400				;C  FOR AUTOMATIC BEAMS.
30500		MOVEI 2,2 	;COMMON/SCM/V(78),I,LCNT,STAFF,LIST(200),REND
30600		ADDB 2,@(16)		;J=J+2
30700		MOVE	4,@1(16)
30800		SUB	4,@3(16)	;L-N
30900		MOVE	5,@2(16)
31000		SUB	5,@3(16)	;K-N
31100		FLTR 4,4		;TLC	4,232000
31200		MOVEM	4,SC+16(2)		;VX(J-1)=L-N
31300	;**** A LIMIT OF 25 BEAMS PER LINE.
31400		FLTR 5,5		;TLC	5,232000
31500		MOVEM	5,SC+17(2)		;VX(J)=K-N
31600		JRA	16,4(16)
31700	
31800	UPDATE:	0	;	SUBROUTINE UPDATE(I)
31900				;COMMON /PTR/PWDS(250),ITEM,LL,IS,IX /XRN/RN(4000)
32000		MOVE 3,LIMIT+3  	;RN(IS)=I
32100		FLTR 2,@(16)		;MOVE	2,@(16)
32200		MOVEM 2,XRN-1(3)
32300					;IS=IS+I+3
32400		MOVE 2,@(16)
32500		ADDI 2,3
32600		ADDM 2,LIMIT+3  
32700		JRA	16,1(16)
32800	
32900	IK:	0	;***** DON'T USE THESE ELSEWHERE, THEY STORE NUMBS.!!
33000	JIT:	0  ; THESE ARE TO STORE PNTRS IN LOOP
33100	NEWR:	0	;	SUBROUTINE R
33200		MOVE	A,SC+=70 ;GET THE MODE # ;COMMON/PTR/PWDS(250),ITEM,LL,IS,IX
33300		CAIE	A,1		;COMMON/XRN/RN(4000)
33400		JRST	N1	;COMMON/SCM/V(78),I,LCNT,STAFF,LIST(200),REND
33500		MOVE JK,LIMIT+3 ;COMMON/SCX/JALPHA(30),JX,U,JZ,IRHY,J4,KA,KB,IZ
33600		MOVEM JK,IK  ;1 /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA,DBST,NFLG
33700		MOVE JT,LIMIT+1    ;1 ,IXX,ISEMI,IQT,VX(50),IAMP,K,KN,M,MODE,IBLA
33800	 	MOVEM	JT,JIT  	;DIMENSION R(10,80)	
33900	N1:	MOVE	IS,IK		;EQUIVALENCE (R,RN(3001))
34000		MOVEM	IS,LIMIT+3  
34100		MOVE 14,[9999.0]
34200		MOVE 	JT,JIT		;IF(MODE.NE.1)GO TO 1
34300		ADDI	JT,1		;IK=IS
34400		MOVEM	JT,LIMIT+1  	;HOMER=ITEM
34500		MOVEI	K,=10		;1	IS=IK
34600		MOVE	IZ,SCX+=37	;ITEM=HOMER+1 ******************** WAS +=33
34700		IMULI	IZ,=10 ;MODE 1=NOTE, 2=RHYTH, 3=ACCENTS, 4=BEAMS, 5=SLURS.
34800	;***N2:	CAMN 14,RINP-3(K)	;IF(R(8,K).EQ.9999.)GO TO 2
34900	;****	JRST	NN2  ;SKIPS INVIS RESTS - ONLY NEEDED IN RHYTH.
35000	N2:	SETO	IEND,		;C  JUMP FOR BEAM CONT.
35100					;IEND=-1
35200		MOVE A,SC+=70		;PUT MODE NUM. INTO A   
35300		MOVE IS,RINP-=10(K)	;GET CODE NUM. FROM R(1,K)
35400		CAMN IS,[1.0]		;IF IT IS 1, IEND=0
35500		JRST NX1		;IF(MODE.NE.2)GO TO NX2
35600		CAMN IS,[2.0]		;IF(CODE IS NOT 2)GO TO NX2
35700	;;	CAME IS,[2.0]		;IF(CODE IS NOT 2)GO TO NX2
35800	;;	JRST NX2
35900		SKIPL RINP-5(K)		;IF(R(6,K).GE.0)GO TO NX2
36000		JRST NX2
36100		SKIPN RINP-4(K)		;IF(R(7,K).EQ.0)GO TO NN2 (DELETE IF INVIS. REST
36200		JRST NN2		; AND NO RHYTHMIC VALUE.)
36300		SKIPA
36400	NX1:	SETZ IEND,
36500	NX2:	MOVE L,LIMIT+3  		;RN(IS+3)=0
36600		SETZM XRN+2(L)		;RN(IS+2)=0
36700		SETZM XRN+1(L)
36800	;;	SETZM LOOP		;LOOP=0    FOR P2→P11 TRANSFER
36900		MOVEI	L,=10 ;C  ↑↑↑↑ TO CLEAR ARRAY FOR SHORT ITEMS (CLEFS)
37000		CAIL A,4		;LK=10 IF(MODE.GT.3)L=7
37100		MOVEI L,8		;ONLY LOOK AT 8 PARAMS AFTER MODE 3.
37200	N3:	HRRZI	R,RINP(K)   	;DO 3 L=LK,1,-1
37300		ADDI	R,(L)		;A=R(L,K)
37400		MOVE A,-13(R)		;(OCTAL) =13
37500		JUMPGE	IEND,NX4	;IF(A.NE.0)GO TO 77
37600		JUMPE	A,NN3		;IF(IEND)GO TO 3
37700	;;	JUMPN	A,NX3		;IF(IEND)GO TO 3
37800	;;	JRST	NN3
37900	NX3:	MOVE	IEND,L		;77	IF(IEND)IEND=L
38000	NX4:	MOVE R,LIMIT+3  
38100		ADDI R,(L)
38200		MOVEM A,XRN-1(R)	;RN(IS+L)=A
38300	NN3:	CAILE	L,1		;3	CONTINUE
38400		SOJA	L,N3
38500		MOVE A,SCM+=80		;A=STAFF #
38600		MOVEM A,XRN(R)		;PUT IT IN P2
38700		CAME IS,[1.0]		;IF NOT CODE 1, SKIP OVER
38800		JRST N4
38900		MOVEI IEND,=11		;SET WDCNT
39000		MOVE A, RINP-9(K)	;GET WHAT'S IN R(2,K)
39100		MOVEM A,XRN+=9(R)	;PUT IT IN P11
39200	N4:	CAIGE	IEND,3		;IF(LOOP.NE.0)RN(IS+11)=LOOP (REAL) 
39300		MOVEI	IEND,3
39400		MOVE	15,IEND		;IF(IEND.LT.3)IEND=3
39500		SUBI	15,2
39600		MOVE SC+=70	  ;IF(A NOTE AND MODE.EQ.3)R(9,K)=PTR TO P11 OF NT.
39700		CAMN IS,[1.0]
39800		CAIE 3
39900		JRST NN4  
40000		MOVE 0,R
40100	 	ADDI =10
40200		FLTR 0			;USE THIS IN SLUR ROUTINE
40300		MOVEM RINP-2(K)		;R(9,K)
40400	NN4:	JSA 	16,UPDATE	;CALL UPDATE(IEND-2)
40500		JUMP	15
40600	NN2:	CAML	K,IZ		;2	CONTINUE
40700		JRA	16,(16)		;END
40800		ADDI	K,=10
40900		JRST	N2
41000	
41100	RNX:	0			;CALL RNX(A,B,C,D,E,F,G,H,I)
41200		MOVE 1,LIMIT+3		;FILLS PARAMS 0→8  RN(IS+0)...RN(IS+8)
41300		MOVE @(16)
41400		MOVEM XRN-1(1)		;CALLED FROM 'BEAMS'
41500		MOVE @1(16)
41600		MOVEM XRN(1)
41700		MOVE @2(16)
41800		MOVEM XRN+1(1)
41900		MOVE @3(16)
42000		MOVEM XRN+2(1)
42100		MOVE @4(16)
42200		MOVEM XRN+3(1)
42300		MOVE @5(16)
42400		MOVEM XRN+4(1)
42500		MOVE @6(16)
42600		MOVEM XRN+5(1)
42700		MOVE @7(16)
42800		MOVEM XRN+6(1)
42900		MOVE @10(16)
43000		MOVEM XRN+7(1)
43100		JRA 16,11(16)
43200	
43300	CNT:	0
43400	MSSLUP:	0
43500		SETZ	1,		;161	CNT=1
43600		SETZ	2,
43700	L5543:	MOVE	3,.COMM.+4(2)	;DO 5543 K=1,10
43800					;RA=RJQ(K)
43900		SKIPE	3		;IF(RA.NE.0)CNT=K
44000		MOVE	1,2		;5543	RJJ(K)=RA
44100		MOVEM 3,RRJJ+1(2)
44200		CAIG	2,=8		; LOOP BACK?  
44300		AOJA	2,L5543
44400		AOJ	1,	;********* WILL SAVE UP TO PARAM 12 ONLY!
44500		MOVEM	1,CNT		;REMEMBERS CNT
44600		JRA	16,(16)
44700	
44800	LUP2:	0		;261	RN(I)=CNT
44900		FLTR 2,CNT		;MOVE	2,CNT
45000		MOVE 1,LIMIT+3  
45100		MOVEM 2,XRN-1(1)
45200		FLTR 2,.COMM.+1		;MOVE	2,.COMM.+1	;RN(I+1)=JA
45300						;I=I+2
45400		MOVEM 2,XRN(1)
45500		MOVE	3,.COMM.	;RN(I)=R2
45600		MOVEM 3,XRN+1(1)
45700		MOVE 5,CNT		;DO 4554 K=1,CNT
45800		ADD 1,CNT
45900		ADDI 1,3
46000		MOVEM 1,LIMIT+3
46100	L4554:	MOVE 2,.COMM.+3(5)
46200		MOVEM 2,XRN-2(1)		;4554	RN(I+K)=RJQ(K)
46300		SOJ 1,    
46400		SOJG 5,L4554		;3554	I=I+CNT+1
46500		JRA	16,(16)
46600	
46700	;;C****** FOR 'HOMING' OF BEAMS AND CHORD NOTES ***********
46800	;;	SUBROUTINE HOMER
46900	;;	IMPLICIT INTEGER(A-Q,S-Z)
47000	;;	REAL PWDS,DISX,A,B,PLACE,STFF
47100	;;	COMMON /STF/RSTFAC(-3/4),RSTJ2
47200	;;    COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20) /POSI/STFF(-3/4),JJ2,POS
47300	;;	COMMON /XRN/RN(4000) /PTR/PWDS(250),ITEM,L,I,IX
47400	;;	COMMON/ALF/QQ(3),K,RA,RB,N,RG,M,X,RE,RF,A,B,DISX,INP(58)
47500	;;	EQUIVALENCE (R3,RJQ(1)),(R6,RJQ(4)),(J11,JQ(9)),(RD,RN(4000))
47600	;;	1,(R7,RJQ(5)),(R9,RJQ(7)),(R11,RJQ(9)),(R13,RJQ(11))
47700	;;	1,(J10,JQ(8)),(R8,RJQ(6)),(J7,JQ(5))
47800	HOMER:	0		; IF(JA.EQ.6)GO TO 9
47900		MOVE	MM,.COMM.+1
48000		CAIN	MM,6
48100		JRST	H9
48200		SKIPE	.COMM.+=14	;IF(R13.NE.0)GO TO 10
48300		JRST	H10	; FOR GENL HOMING; WORDS;  BEAMS;  STEMS;
48400	
48500	;  ALF+=14= IS = WIDTH OF NOTE -- NEEDED BECAUSE OF DIFF. STEM DIRECTIONS.
48600	;  NEXT ADJUSTS STEMS WHEN BEAMS ARE USED.
48700		JSA 16,HOMX
48800		JRA 16,(16)
48900	
49000	H9:	SKIPGE	.COMM.+=32	;9	IF(J11.LT.0)RETURN
49100		JRA	16,(16)		;   IF P11=-1 NO HOMING
49200		MOVM	R,.COMM.+=28	;	X=IABS(J7)/10  CC  X=R7/10.
49300		IDIVI	R,=10		;;;FDVR	R,[=10.0]
49400	;; ********* NOW P10 CAN BE >100 SO NEXT CAN'T WORK	SKIPN 2,.COMM.+=31	;IF(J10.EQ.0)GO TO H100
49500	;;	JRST H100
49600	;;	CAIL 2,=10		;IF(J10.GE.10)X=0 (=LOOK AT ALL STEM DIRS.)
49700	;;	SETZ R,
49800	H100:	MOVEM	R,XNOTE		;X SAVED IN XNOTE = STEM DIR. OF BEAM.
49900	;  R9= POS3
50000	;XXX	MOVNI	RC,1	;RC=-1 
50100	;XXX	SKIPE	.COMM.+=10	;IF(R9.NE.0)RC=-2  ****OR .GT. *******
50200	;XXX	MOVNI	RC,2
50300	;???	MOVE .COMM.+=11		;GET  P10
50400	;???	JUMPE H10		;IGNORE IF 0
50500	;CCC	SKIPLE .COMM.+=8	; SKIP IF R7 IS .LE.0
50600	;CCC	MOVNI	RC,3		;  RC=0 ESCAPES FRCOM LOOP.
50700	;   HOMING RANGE FOR BEAMS
50800	H10:	SKIPN NX,.COMM.+=12	; 10	IF(R11.EQ.0)R11=2.9
50900		MOVE	NX,[=2.9]
51000		MOVEM	NX,.COMM.+=12	;   IF P11.NE.0 RANGE IS CHANGED FROM 2
51100		SETZ IZ,
51200	;XXHX10:	MOVE	IZ,.COMM.+1	;	IF(JA.EQ.5)RC=-1
51300	HX10:	MOVEI	K,1
51400		SETZ RC,
51500		MOVE L,.COMM.+1		; JA IS NOW IN L
51600	;;	CAIN L,5
51700		SUBI L,5		;NOW JA=5 IS L=0
51800		SKIPN L
51900			SETO RC,
52000	H361:	JSA	16,FINDIT		;DO 361 K=1,ITEM
52100		JUMP	K
52200		JUMPL	0,HX361		;IF(FINDIT(K))GO TO 361
52300	;  SKIPS NOTES ON WRONG LINE 
52400		MOVEI	R,XRN		;RD=RN(L+3)
52500		ADD	R,LIMIT+2  	;LOC OF RN(L+1)
52600		MOVE	A,2(R)		;RD IN A
52700		MOVEM	A,RMOD+=9	;1	IF(JA.NE.6)GO TO 177
52800		KIFIX	JK,4(R)		;IF(IFIX(RN(L+5)/10).NE.X)GO TO 361
52900		IDIVI JK,=10		;JK=NOTE'S STEM DIRECTION
53000		CAIE	L,1	;L=1 = JA=6
53100	;;	CAIE	L,6
53200		JRST	H177
53300		JUMPE JK,HX361		;IF(RN(L+5).LT.10)GO TO HX361 (NO STEM)
53400	;;	SKIPN XNOTE		;IF(XNOTE.EQ.0)GO TO H177
53500	;;	JRST H177		;XNOTE=0 = CHECK ALL STEM DIRS.
53600		CAMN JK,XNOTE	  ;ARE STEM DIR,S SAME?
53700		JRST H377	  ;YES, JUMP
53800		MOVE -1(R)
53900		CAML [8.0]
54000		SKIPN JT, =9(R)		;JT='OTHER STAFF' INFO 2=↑  1=↓
54100		SKIPA
54200		JRST HH377		;IF(RN(L+10).EQ.0)GO TO H377
54300	
54400		MOVE .COMM.+5	;LEFT HEIGHT OF BEAM
54500		FADR .COMM.+6	;RIGHT HEIGHT
54600		FDVR [2.0]	;AVERAGE HEIGHT OF BEAM
54700		FSBR 3(R)	;SUBTR HEIGHT OF NOTE
54800		CAIE JK,1	;IF NOTE STEM DOWN, REVERSE SIGN
54900		MOVNS
55000		CAMG [8.0]	; IF DIFF. IS LESS THAN 8 DON'T HOOK BEAM TO STEM.
55100		JRST H377
55200	
55500	HH377:	MOVE 1,RNW   	;RNW IS NOTE WIDTH( CURRENTLY =2.44)
55600		FMPR 1,STF+=8	;*RSTJ2
55700		MOVM NN,.COMM.+=25	;IF(ABS(J4.GE.100)  *.6   (MINI)
55800		CAIL NN,=80   
55850		CAIL NN,=180
55875		SKIPA		;IF(NN.LT.80.OR.NN.GE.180)THEN NOT A MINI
55900		FMPR 1,[0.6]
56000		CAIE JK,1
56100		MOVNS 1
56200		FADR A,1	; ADD OR SUB. NOTE WIDTH FROM NOTE POS.
56300		JRST H177	;ALL NOTES ON 'DIFF. STF' ARE CONSIDERED.
56400	H377:	CAME	JK,XNOTE
56500		JRST	HX361
56600	H177:	JSA	16,PLACE	;177	IF(PLACE(R3))GO TO 461
56700		JUMP	.COMM.+4
56800		JUMPG HXX
56900		JUMPN L,H461	; DO NEXT IF HOMING SLUR
57000	;;	CAIE L,5	; DO NEXT IF HOMING SLUR
57100	;;	JRST H461
57200		JSA 16,PLACE	;ALSO CHECK FOR P6 (RT. END OF SLUR)
57300		JUMP .COMM.+7
57400		JUMPL H461	; IF NEG. = DIDN'T FIND IN THAT AREA
57500		MOVEI .COMM.+7	; GET LOC. OF P6
57600		SKIPA
57700	HXX:	MOVEI .COMM.+4  	;LOC. OF P3
57800		MOVEM NX 	;SAVE LOC. OF EITHER P3 OR P6
57900		SETO IZ,
58000	HX2:	MOVE 5(R)	;GET PARAM 6
58100		CAMGE [10.0]	; MUST BE .GE.10 
58200		JRST HX1
58300		MOVE IS,RNW	; SIZE OF A NOTE  (NOW =2.44)
58400		CAML [20.0]	; 10 = RIGHT SHIFT, 20 = LEFT SHIFT
58500		MOVNS IS
58600		MOVM 3(R)		; GET P4
58700		CAML [80.0]		; IS IT A MINI?
58800		CAML [180.0]
58900		SKIPA
59000		FMPR IS,[0.6]		;*RMINI
59100		MOVE 1,.COMM.+3		;STAFF #
59200		FMPR IS,STF(1)	;*RSTFAC(J2)
59300		FADR A,IS
59400	HX1:	JUMPG IZ,HX8	; JUMP TO CHANGE P6, 8 OR 9
59500	HX3:	MOVEM	A,(NX)  	;R3=RD (OR R6)
59600	;;HX3:	MOVEM	A,.COMM.+4	;R3=RD
59700	;  LOOKS FOR NOTE, STAFF #, STEM DIR.
59800		MOVN .COMM.+=14		;P13=-1 HOME TO NOTE SIDE, =-2 TO STEM.
59900		SKIPG			;IS IT NEG.
60000		JRST H11		; NO, GO TO NEXT SECTION.
60100		MOVEI JT,.COMM.+4	;GET LOC. OF R3
60200		MOVE IS,3(R)	; VERTICAL POS OF NOTE (P4)
60300		CAME [1.0]	;IS P13 -1 OR -2?
60400		JRST H12	;IT'S -2
60500		MOVE [2.0]
60600	;;	CAIE  JK,2		;WHICH WAY IS STEM? 2=STEM DOWN
60700		SKIPG .COMM.+=8		;JUMP IF SLUR CURVES UP (STEMS DOWN) IN P7
60800		MOVNS		;ELSE MAKE DISPLACEMENT NEG.
60900		FADR IS		;ADD NOTE LEVEL
61000	;;	MOVEM .COMM.+5		;P4=NOTE LEVEL + OR - 2.
61100		JRST HZ
61200	H12:	MOVE IZ,7(R)	; STEM LENGTH
61300		CAMN IZ,[999.0]   ; WHAT ABOUT 16TH AND 32ND NOTES??
61400		SETZ IZ,
61500		FADR IZ,[8.0]
61600		JSA 16,AMOD
61700		JUMP 6(R)
61800		JUMP [10.0]	;AC0=AMOD(R7,10.0)
61900	;;	SKIPN
62000	;;	JRST H13
62100		JUMPE H13
62200		FSBR [1.0]	;IGNORE 1ST TAIL
62300		FMPR [1.8]	; *SPACE FOR EACH TAIL
62400	H13:	FADR IZ 	; ADD TO STEM LENGTH
62500	    	CAIL JK,2	; <2 = STEM UP
62600		MOVNS 		;PUT IT UPSIDE DOWN.
62700		FADR IS   	;ADD NOTE LEVEL
62800	;;	MOVEM IS,.COMM.+5	;PUT IT BEYOND STEM
62900	HZ:	CAME JT, NX		;ARE WE LOOKING AT R3 OR R6 (JT=R3)
63000		JRST .+3	;JUMP FOR R6
63100		MOVEM   .COMM.+5	;PUT VERT. POS. INTO R4
63200		SKIPA
63300		MOVEM .COMM.+6	;PUT VERT. POS. INTO R5
63400	
63500	;;H11:	CAIN	L,6		;IF(JA.EQ.6)GO TO 861
63600	;;	JRST	 H861
63700	;;	CAIN	L,5		;IF(JA.EQ.5)GO TO 261
63800	;;	JRST	HX361
63900	H11:	CAIN	L,1		;IF(JA.EQ.6)GO TO 861
64000		JRST	 H861
64100	  	JUMPE L,HX361		;IF(JA.EQ.5)GO TO 261
64200		JRA	16,(16)		;RETURN
64300	;;H461:	CAIN	L,6		;461	IF(JA.EQ.6)GO TO 277
64400	;;	JRST	H277
64500	;;	CAIE	L,5		;IF(JA.NE.5)GO TO 361
64600	;;	JRST	HX361
64700	H461:	CAIE	L,1		;461	IF(JA.EQ.6)GO TO 277
64800		JUMPN L,HX361		;IF(JA.NE.5)GO TO 361
64900	H277:	JSA	16,PLACE	;277	IF(PLACE(R6))GO TO 561
65000		JUMP	.COMM.+7
65100		JUMPL	H561
65200		MOVEI IZ,7		;R6=RD
65300		JRST HX2
65400	H861:	MOVE	0,.COMM.+=28	;861	IF(J7.GE.0)GO TO 261
65500		JUMPGE	0,HX361
65600	H561:	MOVE .COMM.+=10		;IF(R9.LE.0)GO TO 661
65700		JUMPLE H661
65800		JSA	16,PLACE	;561	IF(PLACE(R9))GO TO 661
65900		JUMP	.COMM.+=10	;R9
66000		JUMPL	H661
66100		SKIPL	.COMM.+=28	;IF(J7)GO TO 761   J7=NEG MEANS TREMOLO
66200		SKIPE	.COMM.+=9	;	IF(R8.NE.0)GO TO 761
66300		JRST H761
66400	;;	MOVE	0,.COMM.+=28	;IF(J7)GO TO 761
66500	;;	JUMPL	H761	;  J7=NEG MEANS TREMOLO
66600	;;	MOVE	0,.COMM.+=9	;	IF(R8.NE.0)GO TO 761
66700	;;	JUMPN	H761
66800		MOVE	0,.COMM.+=11	;	IF(R10.EQ.0)GO TO 361
66900		JUMPE	HX361
67000	H761:	MOVEI IZ,=10		;761	R9=RD
67100		JRST HX2
67200	;  R8=0, R10=0 MEANS R9 IS NUMBER OUTSIDE OF BEAM.    ; GO TO 261
67300	;;H661:	CAIN	L,5		;661	IF(JA.EQ.5)GO TO 361
67400	;;	JRST	HX361
67500	H661:	JUMPE	L,HX361		;661	IF(JA.EQ.5)GO TO 361  L=1 = JA=5
67600	;;	MOVE	0,.COMM.+=31	;IF(J10.LT.30)GO TO 361
67700	;;	CAIGE	0,=30
67800		SKIPN .COMM.+=31	;IF J10.EQ.0 GO TO 361
67900		JRST	HX361
68000		JSA	16,PLACE	;IF(PLACE(R8))GO TO 361
68100		JUMP	.COMM.+=9
68200		JUMPL	HX361	; HOMES INNER PARTIAL BEAMS
68300		MOVEI IZ,=9		;R8=RD
68400		JRST HX2
68500	HX8:	MOVEM	A,.COMM.(IZ)	;PUT A INTO RIGHT PARAM.
68600	;XXXH261:	SKIPN	RC       	;261	IF(RC.EQ.0)RETURN
68700	;XXX	AOJ	RC		;RC=RC+1
68800	HX361:	CAMGE	K,LIMIT+1  	;361 	CONTINUE
68900		AOJA	K,H361
69000		JRA	16,(16)		;	END
69100	
69200	;;PFIBX:	0	;DATA FIB/0.618/, RFIB/-.382/,ALG/0.6931472/
69300			;100	ACCEPT 10,A   10	FORMAT(F)
69400	;;	MOVE 12,@(16)		;PFIBX=14
69500	;;	MOVE 13,[14.0]		;IF(A.EQ.1)GO TO 20
69600	;;	CAMN 12,[1.0]		;Z=FIB
69700	;;	JRST PFX		;IF(A.LT.1)Z=RFIB
69800	;;	JSA 16,ALOG		;RH=ABS(ALOG(A)/ALOG(2.0))
69900	;;	JUMP 12
70000	;;	FDVR 0,[0.6931472]	;ALOG(2.0)
70100	;;	MOVM 11,0
70200	;;	MOVE 10,[0.618]		;FIB FACTOR
70300	;;	SKIPG    		;L=RH
70400	;;	MOVN 10,[0.382]		;IF(L.EQ.0)GO TO 4
70500	;;	KIFIX 7,11
70600	;;	MOVE 6,7		;SAVE L FOR LATER
70700	;;	JUMPE 6,PFZ
70800	;;PF:	MOVE 2,13		;	DO 3 K=1,L
70900	;;	FMPR 2,10		;3	PFIBX=PFIBX+PFIBX*Z
71000	;;	FADR 13,2
71100	;;	SOJG 6,PF
71200	;;PFZ:	FLTR 7,7		;4	RH=RH-L
71300	;;	FSBR 11,7		;IF(RH.EQ.0)GO TO 20
71400	;;	JUMPE 11,PFX	
71500	;;	MOVE 2,13
71600	;;	FMPR 2,10
71700	;;	FMPR 2,11		;PFIBX=PFIBX+PFIBX*Z*RH
71800	;;	FADR 13,2
71900	;;PFX:	MOVE 0,13		;SEND BACK THE RESULT
72000	;;	JRA 16,1(16)
72100	
72200	CODN:	0		;FUNCTION CODN(K,N)
72300		MOVE 1,@(16)		;GET CODE NUMBER AND RETURN POINTER
72400		MOVE 2,PTR-1(1)		;L=KWDS(K)
72500		MOVEM 2,@1(16)
72600		MOVE XRN(2)		;CODN=RN(L+1)
72700		JRA 16,2(16)
72800	
72900	FSCAN:	0
73000		INCHRW
73100		MOVE 2,[ASCII/     /]
73200		MOVEM 2,ALF
73300		MOVE 2,[XWD ALF,ALF+1]
73400		BLT 2,ALF+=71			; CLEANS OUT INP ARRAY
73500		CAIN ";"
73600		JRA 16,(16)
73700		CAIN ":"
73800		JRA 16,1(16)
73900		CAIN "("
74000		JRA 16,2(16)
74100		CAIN ")"
74200		JRA 16,3(16)
74300		CAIN "/"
74400		JRA 16,4(16)
74500		CAIN "*"
74600		JRA 16,5(16)
74700		CAIN "X"
74800		JRA 16,6(16)
74900		CAIN "C"
75000		JRA 16,7(16)
75100		JRA 16,8(16)
75200	
75300	
75400	NALF:	0
75500		MOVE 0,@(16)
75600		JUMPGE .+4		;IF(I.GE.0)GO TO 20
75700		MOVE 1,[405004020100]	;  J='A'=405004020100
75800		SETO 2,			; M=-1
75900		JRST .+3		;GO TO 10
76000		MOVE 1,[201004020100]	;20  J=' '=201004020100
76100		MOVEI 2,=16		; M=16
76200		SUB 0,1			;10 NALF=(I-J)/536870912-M
76300		IDIV 0,[3777777777]	
76400		SUB 0,2
76500		JRA 16,1(16)
76600	
76700	BOX:	0    	;CALL BOX(I,R)   SEE PLTSRT.F4 FOR FORTR. VERSION
76800		MOVE IDEV
76900		CAIE 5
77000		JRA 16,2(16)	;IF(IDEV.NE.5)RETURN
77100	     	MOVE 14,@(16)	; I IS IN 14
77200		JUMPL 14,BX4
77300		KIFIX 13,@1(16)	;K=R	;MOVE 13,@1(16)	; GET R
77400		JSA 16,AMOD
77500		JUMP XRN+3(14)	; GET REAL P4
77600		[100.0]
77700		CAMGE [-20.0]	;IF(P4.LT.-20)P4=P4+100
77800		FADR [100.0]	; FOR P4=-95 ETC.
77900		CAML [80.0]	;IF(P4.GE.80)P4=P4-100
78000		FSBR [100.0]	; CATCHES NEG. MINIS, ETC.
78100		FMPR [7.0]
78200		FMPR STF(13)	;*STAFF FACTOR
78300		FADR POSI(13)	; + STAFF VERT. POS.
78400		FSBR [40.0]	;  SHIFT CURSOR DOWN A BIT.
78500		FMPR SIZ
78600		KIFIX 13,0	
78700		SUB 13,SIZ+2	;13=K
78800		JSA 16,RHORZ	; GET HORIZ. POS.
78900		JUMP XRN+2(14)
79000		FMPR SIZ	;SIZ IS FOR ZOOMED IMAGES
79100		KIFIX 12,0		;MOVE 12,	;  12=L
79200		SUB 12,SIZ+1
79300		CAIL 12,=550	; CHECK IF OUT OF BOUNDS OF CRT
79400		MOVEI 12,=511
79500		CAMG 12,[-=550]
79600		MOVE 12,[-=511]
79700		JSA 16,SETCUR
79800		12
79900		13
80000		[0]
80100		MOVE DL		;IOLD=X22   FOR TYPING "I <CR>" TO GET LAST EDIT BACK.
80200		MOVEM DL+4
80300		JRA 16,2(16)	; THE CURSOR IS IN POSITION
80400	BX4:	CAME 14,[-1]
80500		JRST BX5
80600		JSA 16,DPYSET
80700		[3]
80800		RINP
80900		[=100]
81000		JSA 16,DPYBRT
81100		[3]
81200	BX5:	MOVE 2,@1(16)	; GET R
81300		JSA 16,RHORZ
81400		2
81500		FMPR SIZ
81600		KIFIX 0,0
81700		SUB SIZ+1
81800		MOVM 2,
81900		CAILE 2,=550
82000		JRST BX6
82100		MOVEM 0,LOOP
82200		JSA 16,SETPOG
82300		[3]
82400		JSA 16,ALINE
82500		LOOP
82600		[-=511]
82700		LOOP
82800		[=511]
82900		JSA 16,DPYOUT
83000		[3]
83100	BX6:	JSA 16,SETPOG
83200		[1]
83300		JRA 16,2(16)
83400	
83500	PARCH:	0		;CALL PARCH(JA,JJA,RD)
83600		MOVE 2,@(16)	;GET JA
83700		CAIN 2,2	;IS IT P2
83800		JRST .+8
83900		CAIE 2,1	;IS IT P1
84000		JRA 16,3(16)	;NEITHER
84100		KIFIX 3,@2(16)	;GET RD
84200		JUMPE 3,.+3	; REJECTS CODE # 0.
84300		CAIG 3,=18	;IS PARAM .GT.18?
84400		MOVEM 3,@1(16)	;PUT IT INTO JJA
84500		JRA 16,3(16)	;ALL DONE
84600		MOVE 3,@2(16)	;GET RD
84700		CAMG 3,[7.0]	;REJECTS STAFF # .GT.7
84800		MOVEM 3,RRJJ	; PUT IT AWAY
84900		JRA 16,3(16)
85000	
85100	RCURVE:	0	;   R7=RCURVE(R3)
85200		MOVE 2,(16)	;	R7=0.9+(R6-R3)/25.+ABS(R4-R5)/10.
85300		MOVE 1,3(2)
85400		FSBR 1,(2)		;R6-R3
85500		MOVE 3,5(2)		;IF(R8.LT.-1)Z=Z+R8*2.
85600		FADR 3,[1.0]
85700		JUMPGE 3,RCRV		;R8=-2=BETWEEN NOTES, =-3=1ST NOTE IS DOTTED.
85800		FADR 3,3    
85900		FADR 1,3
86000	RCRV:	FDVR 1,[25.0]		; /25.
86100		MOVE 0,2(2)
86200		FSBR 0,1(2)		;R5-R4
86300		MOVMS			;ABSOLUTE VALUE
86400		FDVR 0,[10.0]		; /10.
86500		FADR 0,1
86600		FADR 0,[0.9]		; +.9
86700		SKIPGE 4(2)		;IF(R7 WAS .LT.0)KEEP IT NEGATIVE.
86800		MOVNS
86900		JRA 16,1(16)
87000	
87100	RJED:	0		;6222	DO 1222 K=1,20,2
87200		MOVEI 1,1
87300	RJ1:	SKIPN .COMM.+=23(1)
87400		JRA 16,(16)
87500		MOVE 4,.COMM.+=23(1)	;L=JQ(K)
87600				;IF(L.EQ.0)GO TO 6221
87700			;  '600 2'  WILL ADD 2 TO PARAM 6.  '3000 6' SETS P3=P6.
87800		MOVE 5,.COMM.+4(1)	;RD=RJQ(K+1)
87900		MOVE 6,4		;X=L
88000		CAIGE 4,=100		;IF(L.LT.100)GO TO 223
88100		JRST RJ223
88200		CAIGE 4,=2000		;IF(L.LT.2000)GO TO 5223
88300		JRST RJ5223
88400		IDIVI 6,=1000		;X=L/1000
88500		MOVE 4,.COMM.+=24(1)	;L=JQ(K+1)-2
88600		SUBI 4,2
88700		MOVE 5,RRJJ(4)		;RD=RJJ(L)
88800		JRST RJ2223		;GO TO 2223
88900	RJ5223:	IDIVI 6,=100		;5223	X=L/100
89000		CAIN 6,2		;IF(X.EQ.2)GO TO 1223
89100		JRST RJ1223
89200		FADR 5,RRJJ-2(6)	;RD=RJJ(X-2)+RD
89300		JRST RJ2223		;GO TO 2223
89400	RJ1223:	FADR 5,RRJJ		;1223	RD=RJJ2+RD
89500	RJ223:	CAIG 6,2		;223	IF(X.LE.2)GO TO 3223
89600		JRST RJ3223
89700	RJ2223:	MOVEM 5,RRJJ-2(6)	;2223	RJJ(X-2)=RD
89800		JRST RJ1222		;GO TO 1222
89900	RJ3223:	JSA 16,PARCH		;3223	CALL PARCH(X,JJA,RD)
90000		6	; NOW P1 CAN BE CHANGED IN EDIT MODE -- BE CAREFUL,,,,!!!!!!
90100		RRJJ+21
90200		5
90300	RJ1222:	ADDI 1,2
90400		CAIG 1,=20		;1222	CONTINUE
90500		JRST RJ1  ;***  LOOP SET TO 20(20 IN ARRAY!) ONLY 13 PARAMS POSSIBLE NOW.
90600		JRA 16,(16)
90700	
90800	RJED2:	0
90900		MOVEI 1,=11		;6221	DO 5514 K=1,11
91000	RJ6221:	MOVE 3,RRJJ(1)		;R2=RJJ(K)
91100		MOVEM 3,.COMM.+3(1)	;RJQ(K)=R2
91200		KIFIX 3,3
91300		MOVEM 3,.COMM.+=23(1)	;5514	JQ(K)=R2
91400		SOJG 1,RJ6221
91500		MOVE RRJJ		;R2=RJJ2
91600		MOVEM .COMM.
91700		MOVE RRJJ+=21		;JA=JJA
91800		MOVEM .COMM.+1
91900		SOS LIMIT+1		;ITEM=ITEM-1
92000		SKIPGE LIMIT+1		;IF(ITEM)ITEM=0
92100		SETZM LIMIT+1
92200		JRA 16,(16)
92300	
92400	EDX:	0			;FUNCTION EDX(RLINE)
92500		MOVE 2,JCHAR+4		;AC2=JED
92600		CAMLE 2,LIMIT+1		;244	X=ITEM  
92700		JRST E444		;IF(JED.GT.X)GO TO 444
92800		MOVE 6,.COMM.+1		;AC6=JA
92900		MOVE 4,JCHAR+6		;AC4=REDIT
93000		MOVE 3,JCHAR+5		;AC3=KED
93100		MOVE 5,JCHAR+7		;AC5=RITEM
93200		SETZ 7,			;FLAG FOR '33' FEATURE
93300		CAME 5,[33.0]		;IF CODE NUM 33 IS TYPED IT MEANS ALL THINGS
93400		CAMN 5,[44.0]		;USE 44 FOR NON-BARLINES IN CODE 4
93500		SKIPA
93600		JRST EDZ		;UNDER CODE 3 EXCEPT P5=0,1,2,3,4,5 (REAL CLEFS)
93700	     	SETO 7,
93800		FDVR 5,[11.0]		;CHANGE 33,44 BACK TO 3,4
93900	EDZ:	MOVE 1,PTR-1(2)		;	DO 144 K=JED,X
94000		CAMN 3,[-2]		;L=PWDS(K)
94100		JRST E654		;IF(KED.EQ.-2)GO TO 654
94200	;  -2 LOOKS AT ALL ITEMS NEAR VERT. LINE, -1 ON SINGLE STAFF.
94300		CAIN 3,2		;IF(KED.EQ.2)GO TO 656
94400		JRST E656
94500		CAME 4,XRN+1(1)		;IF(RN(L+2).NE.REDIT)GO TO 144
94600		JRST E144
94700		JUMPL 3,E654		;IF(KED)GO TO 654
94800		JUMPE 5,E655		;IF(RITEM.EQ.0)GO TO 655
94900	E656:	CAME 5,XRN(1)		;656	IF(RITEM.NE.RN(L+1))GO TO 144
95000		JRST E144
95100		JUMPE 7,E655		;SKIP NEXT UNLESS '33,44' FLAG IS SET (AC7=-1)
95200		MOVE XRN-1(1)		;IF(RN(L).EQ.1)GO TO 144 (TREBLE CLEF)
95300		CAMG [2.0]
95400		JRST E144
95500		CAMN 5,[4.0]		;IF(RITEM.EQ.4)GO TO 655
95600		JRST E655		;JUMP IF WDCNT OF CODE 4 .GT.2
95700		MOVE XRN+4(1)		;IF(RN(L+5).LE.5)GO TO 144 (SOME REAL CLEF)
95800		CAMG [5.0]
95900		JRST E144
96000	E655:	CAIE 6,=55		;655	IF(JA.NE.55)GO TO 344
96100		JRST E344
96200	E654:	MOVE @(16)		;654	IF(ABS(RLINE-RN(L+3)).LT.5.0)GO TO 344
96300		FSBR XRN+2(1)
96400		MOVMS
96500		CAMGE [5.0]
96600		JRST E344
96700	E144:	CAMGE 2,LIMIT+1		;144	CONTINUE
96800		AOJA 2,EDZ
96900	E444:	MOVE [999.0]		;444	REDIT=999.
97000		MOVEM JCHAR+6		;C  NO MORE ON LINE
97100		SETZM .COMM.		;R2=0
97200	;   SO IT WILL RETURN IF NOTHING IS FOUND WITH 'ED' OR 'ST'.
97300		JRA 16,1(16)		;GO TO 73
97400	E344:	MOVEM 2,DL		;344	JED=K+1
97500		AOJ 2,			;C  FOR NEXT TIME AROUND
97600		MOVEM 2,JCHAR+4
97700		SETO			;X22=K
97800		JRA 16,1(16)		;AC0=-1=GO TO 429, =>0=GO TO 73
97900	
98000	EQUAL:	0			;CALL EQUAL
98100		MOVE 2,.COMM.+1		;IF(JA.LE.13)GO TO 324
98200		CAIG 2,=13
98300		JRST EQ324
98400		IDIVI 2,=10		;JA=JA/10
98500	; ADD 1000 TO PARAM TO MAKE EQUAL TO ANOTHER PARAM
98600		KIFIX 3,.COMM.		;	X=R2-2.
98700		MOVE RRJJ-2(3)		;RJJ(JA-2)=RJJ(X)
98800		MOVEM RRJJ-2(2)
98900		JRA 16,1(16)		;GO TO 6222
99000	EQ324:	MOVE .COMM.	;GET R2
99100		SKIPGE @(16)    	;(X)    324	I1=JA-2
99200		JRST   EQ224		;IF(X)GO TO 224
99300		MOVEM RRJJ-2(2)		;RJJ(I1)=R2
99400		JRA 16,1(16)		;GO TO 6222
99500	EQ224:	FADRM RRJJ-2(2)		;224	RJJ(I1)=RJJ(I1)+R2
99600		JRA 16,1(16)
99700	
99800	
99900	BOXX:	0		;CALL BOXX
     

00100		MOVE LIMIT+3		;429	IX=I
00200		MOVEM LIMIT+4
00300		MOVE 1,DL		;	MEDIT=PWDS(X22)
00400		MOVE 1,PTR-1(1)
00500		MOVEM 1,DPY+=4000
00600	;;	MOVEI 2,2		;	J=2
00700		KIFIX 3,XRN-1(1)		;;426	Y=RN(MEDIT)+J
00800		ADDI 3,2
00900		MOVEM 3,EQUAL		; EQUAL IS 'Y'
01000		JSA 16,LOOP	;	CALL LOOP(0,Y,1,I,MEDIT,RN)
01100		[0]
01200		EQUAL
01300		[1]
01400		LIMIT+3
01500		DPY+=4000
01600		XRN
01700		MOVE 3,LIMIT+3		;	JJA=RN(I+1)
01800		KIFIX 3,XRN(3)
01900		MOVEM 3,RRJJ+=21
02000		MOVE EQUAL		;	YED=Y-2
02100		SUBI 2
02200		MOVEM YED
02300		MOVE 1,LIMIT+3		;	L=I+2
02400		ADDI 1,2
02500		MOVE 3,1		;AC3=K+L-1
02600		MOVEI 2,1		; AC2 = K
02700	BXX:	CAMLE 2,YED		;	DO 422 K=1,11
02800		JRST BX423		;	IF(K.GT.YED)GO TO 423
02900		MOVE XRN(3)		;	RJJ(K)=RN(L+K)
03000		MOVEM RRJJ(2)
03100		JRST BX422		;	GO TO 422
03200	BX423:	SETZM RRJJ(2)		;423	RJJ(K)=0
03300	BX422:	AOJ 3,			; UPDATE K+L-1
03400		CAIGE 2,=11		;422	CONTINUE
03500		AOJA 2,BXX
03600		MOVE XRN-1(1)		;	RJJ2=RN(L)
03700		MOVEM RRJJ
03800		SKIPLE DPY+=4001	;	IF(IGO.GT.0)GO TO 4231
03900		JRST BX4231		;  NO BOX WHEN IN GROUP EDIT ROUTINE
04000		MOVEM YED+2		;	RBOX=RJJ2
04100		MOVE LIMIT+3		;	IBOX=I
04200		MOVEM YED+1
04300		JSA 16,BOX		;	CALL BOX(IBOX,RBOX)
04400		YED+1
04500		YED+2
04600	BX4231:	AOS LIMIT+1		;4231	ITEM=ITEM+1
04700		MOVE 1,LIMIT+1
04800		MOVE DPTR-1(1)		;	ST2=WDS(ITEM)
04900		JRA 16,(16)		; 	RETURN
05000	
05100		END